#lang racket


(require "../backends/main.rkt")

(require (prefix-in com: "ac-com.rkt")
         (prefix-in alisp: "ac-autolisp.rkt")
         "ac-shape.rkt")

(provide (rename-out (com:load-autocad-com load-autocad-marshall))
         
         ; shapes
         add-arc
         add-elliptical-arc
         add-circle
         add-donut
         add-ellipse
         add-helix-2d
         add-line
         add-polyline
         add-ngon
         add-nurbs-curve
         add-nurbs-surface
         add-rectangle
         add-spline
         add-star
         ;add-text
         
         add-box
         add-cone
         add-cone-frustrum
         add-cylinder
         add-sphere
         
         ; operations
         add-extruded-solid
         add-region
         delete
         intersect
         join
         loft
         move
         offset
         rotate3d
         scale
         subtract
         sweep
         union
         
         ; properties
         position
         get-object-name
         
         ; arc properties
         arc?
         get-arc-center
         get-arc-radius
         get-arc-begin-angle
         get-arc-end-angle
         
         ; autocad
         add-arc-ppp
         
         (rename-out (com:start-undo-mark begin-undo-mark)
                     (com:end-undo-mark end-undo-mark)
                     (alisp:redo redo)
                     (alisp:regen redraw)
                     (alisp:undo undo)))


(define (add-arc center radius start-angle end-angle)
  (make-autocad-shape
   (com:add-arc
    (vector<real><-point center)
    (real<-number radius)
    (real<-number start-angle)
    (real<-number end-angle))))

(define (add-elliptical-arc)
  (error 'add-elliptical-arc "Not implemented"))

(define (add-circle center radius)
  (make-autocad-shape
   (com:add-circle
    (vector<real><-point center)
    (real<-number radius))))

(define (add-donut)
  (error 'add-donut "Not implemented"))

(define (add-ellipse center major-axis radius-ratio)
  (make-autocad-shape
   (com:add-ellipse
    (vector<real><-point center)
    (real<-number major-axis)
    (real<-number radius-ratio))))

(define (add-helix-2d)
  (error "Not implemented"))

(define (add-line start-point end-point)
  (make-autocad-shape
   (com:add-line
    (vector<real><-point start-point)
    (vector<real><-point end-point))))

(define (add-polyline points)
  (make-autocad-shape
   (com:add-polyline
    (apply vector-append (map vector<real><-point points)))))

(define (add-ngon)
  (error 'add-ngon "Not implemented"))

(define (add-nurbs-curve)
  (error 'add-nurbs-curve "Not implemented"))

(define (add-nurbs-surface)
  (error 'add-nurbs-surface "Not implemented"))

(define (add-rectangle)
  (error 'add-rectangle "Not implemented"))

(define (add-spline points start-tangent end-tangent)
  (make-autocad-shape
   (com:add-spline
    (apply vector-append (list<vector<real>><-list<point> points))
    (vector<real><-point start-tangent)
    (vector<real><-point end-tangent))))

(define (add-star)
  (error 'add-star "Not implemented"))


(define (add-box origin length width height)
  (make-autocad-shape
   (com:add-box
    (vector<real><-point origin)
    (real<-number length)
    (real<-number width)
    (real<-number height))))

(define (add-cone center base-radius height)
  (make-autocad-shape
   (com:add-cone
    (vector<real><-point center)
    (real<-number base-radius)
    (real<-number height))))

(define (add-cone-frustrum center base-radius top-radius height)
  (make-autocad-shape
   (alisp:cone-frustrum-command
    (vector<real><-point center)
    (real<-number base-radius)
    (real<-number top-radius)
    (real<-number height))))

(define (add-cylinder center radius height)
  (make-autocad-shape
   (com:add-cylinder
    (vector<real><-point center)
    (real<-number radius)
    (real<-number height))))

(define (add-sphere center radius)
  (make-autocad-shape
   (com:add-sphere
    (vector<real><-point center)
    (real<-number radius))))


; operations

(define (add-extruded-solid profile height taper-angle)
  (make-autocad-shape
   (com:add-extruded-solid
    (autocad-shape-id profile)
    (real<-number height)
    (real<-number taper-angle))))

(define (add-region shapes)
  (map make-autocad-shape
       (vector->list
        (com:add-region
         (list->vector (map autocad-shape-id shapes))))))

(define (delete shape)
  (if (vector? (autocad-shape-id shape))
      (vector-map com:delete (autocad-shape-id shape))
      (com:delete (autocad-shape-id shape))))

(define (intersect shape1 shape2)
  (let ((intersect 1))
    (make-autocad-shape
     (com:boolean
      intersect
      (autocad-shape-id shape1)
      (autocad-shape-id shape2)))))

(define (join shapes)
  (make-autocad-shape
   (alisp:join-command (map autocad-shape-id shapes))))

; edit: What about closed?
(define (loft closed shapes)
  (make-autocad-shape
   (alisp:loft-command (map autocad-shape-id shapes))))

(define (move shape point1 point2)
  (make-autocad-shape
   (com:move
    (autocad-shape-id shape)
    (vector<real><-point point1)
    (vector<real><-point point2))))


; offset

(define (make-offset-entity shape distance)
  (begin0
    (vector-ref
     (com:offset (autocad-shape-id shape) (real<-number distance))
     0)
    (delete shape)))

(define (offset shape distance)
  (make-autocad-shape
   (make-offset-entity shape distance)))

; /offset


(define (rotate3d shape point1 point2 rotation-angle)
  (make-autocad-shape
   (com:rotate3d
    (autocad-shape-id shape)
    (vector<real><-point point1)
    (vector<real><-point point2)
    (real<-number rotation-angle))))

(define (scale shape scale)
  (make-autocad-shape
   (com:transform-by
    (autocad-shape-id shape)
    (scale-matrix<-point scale))))

(define (subtract shape1 shape2)
  (let ((subtraction 2))
    (make-autocad-shape
     (com:boolean
      subtraction
      (autocad-shape-id shape1)
      (autocad-shape-id shape2)))))

(define (sweep shape1 shape2)
  (make-autocad-shape
   (alisp:sweep
    (autocad-shape-id shape1)
    (autocad-shape-id shape2))))

(define (union shape1 shape2)
  (let ((union 0))
    (make-autocad-shape
     (com:boolean
      union
      (autocad-shape-id shape1)
      (autocad-shape-id shape2)))))


; properties

(define (position shape)
  (error 'position "Not implemented"))

(define (get-object-name shape)
  (com:get-object-name (autocad-shape-id shape)))


; arc properties

(define (arc? shape)
  (com:arc? (autocad-shape-id shape)))

(define (get-arc-center shape)
  (vector->list
   (com:get-arc-center (autocad-shape-id shape))))

(define (get-arc-radius shape)
  (com:get-arc-radius (autocad-shape-id shape)))

(define (get-arc-begin-angle shape)
  (com:get-arc-start-angle (autocad-shape-id shape)))

(define (get-arc-end-angle shape)
  (com:get-arc-end-angle (autocad-shape-id shape)))


; autocad

(define (add-arc-ppp p1 p2 p3)
  (make-autocad-shape
   (alisp:arc-ppp-command
    (vector<real><-point p1)
    (vector<real><-point p2)
    (vector<real><-point p3))))